perm filename DMOS.VLI[VLI,LSP] blob sn#381978 filedate 1978-09-08 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(de prname ()
C00003 00003	(dmo ? (dom name)
C00006 ENDMK
C⊗;
(de prname ()
  (prin1 (nextl name))
  (setq indice (car name))
  (if (cdr indice) (prin1 "<" indice ">")))      
(dmo ! (domain name)
  (setq racine (cassoc domain
    '(((1)."nb")
     ((2)."lit")
     ((4)."listp")
     ((1 2)."nblit")
     ((1 3)."nbnil")
     ((1 4)."nblistp")
     ((2 3)."litnil")
     ((2 4)."litlistp")
     ((3 4)."list")
     ((1 2 3)."atom")
     ((1 2 4)."¬nil")
     ((1 3 4)."nblist"))))
           (prin1 (concat "!" racine))
           (status 2 25)
           (prname)
           (prin1 '/ )
           (status 1 25))
(status 2 27)
(dmo ? (dom name)
   (if (memq (car name) %id%) (prin1 (car name))
       (cond ((status 4 25)
               (prin1 (concat "?" (if (eq dom 'nnil) "¬nil")))
               (status 2 25)
               (prname)
               (prin1 '/ )
               (status 1 25))
             (t (prin1 (concat "?" (if (eq dom 'nnil) "¬nil")))
                (prname)))))
(setq %id%)
(dmo %l% (patt ind rest)
  ((lambda (i borne %id%)
    (prin1 "(LL")
    (status 2 25)
    (prin1 "<" i '/  borne ">")
    (status 1 25)
    (prin1 patt)
    (if rest (prin1 rest))
    (status 2 25) (prin1 ")") (status 1 25))
   (car ind) (cadr ind) (cons (car ind) %id%)))
(dmo %seq% l (out%nb%))
(dmo %nb% l (out%nb%))
(de out%nb% ()
   (cond ((status 4 25)
          (status 2 25)
          (prin1 '/ )
          (ifn l (prin1 "0") (prnb 0))
          (status 1 25))
         (l (prnb 0))))
(de prnb (k p)
  (while (cdr l)
    (cond ((eq (car l) 1) (incr k) (nextl l))    
          (t (setq p t) (prin1 (nextl l) "+"))))
  (if (eq (car l) 1) (setq p nil k (add1 k))
      (if p (prin1 (car l)) (prin1 (car l) "+")))
  (if (nerop k) (if p (prin1 "+" k) (prin1 k))))
(dmo ref l
   (terpri)                         
   (status 7 8) (terpri)                                       
   (print "REF" (nextl l))                              
   (status 7 12) (terpri)
   (while l (print (nextl l) (nextl l) (nextl l)))
   (status 7 0) (terpri))